Shareware Grab Bag/Shareware Grab Bag.iso/013/filecat2.arc/LITTLCAT.PAS

Pascal/Delphi Source File | 1986-05-14 | 59.0 KB | 2,043 lines

{$C-}

PROGRAM LITTLCAT; { Written 5/12/86 by Kenn Flee, Madison WI }
                  { Requires Turbo 3.X and Database ToolBox  }
                  { Copyright (C) 1986 by Jamestown Software }
                  { For NonCommercial use only.............. }

CONST
  MaxDataRecSize = 100;
  MaxKeyLen      =  20;
  PageSize       =  24;
  Order          =  12;
  PageStackSize  =   8;
  MaxHeight      =   5;

{.L-}

{$I ACCESS.BOX}
{$I GETKEY.BOX}
{$I ADDKEY.BOX}
{$I DELKEY.BOX}
{$I SORT.BOX}

{.L+}

TYPE
  Name = String[12];
  Str3 = String[3];
  Str8 = String[8];
  Str11 = String[11];
  Str15 = String[15];
  Str42 = String[42];
  Str79 = String[79];
  Str80 = String[80];
  Str255 = String[255];
  AnyStr = String[255];
  CharSet = Set of Char;
  Reg = Record case Integer of
          1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Integer);
          2: (AL,AH,BL,BH,CL,CH,DL,DH          : Byte);
        End;
  FRec = Record
           Status   : Integer;
           FileName : Str8;
           FileExt  : Str3;
           FileTime : Integer;
           FileDate : Integer;
           FileSize : Array[1..4] of Byte;
           VolName  : Str11;
         End;
  EA = Array[1..250] of FRec;

VAR
  ExFile : File;
  FileName : Name;
  MatchName : Str11;
  Ch : Char;
  MenuChoice : Char;
  TDate : Str8;
  CMode,NewMenu,
  InitFiles :Boolean;
  CFile  : DataFile;
  CIndex : IndexFile;
  DOSNum : Str3;
  Error : Integer;
  SortKey : Str42;
  DTA3 : Array[1..43] of Char;
  ASCIIZ : Array[1..64] of Char;
  FileRec         : FRec;
  Regs            : Reg;
  OldVolumeName   : String[11];
  OldVolumeNameDate : String[20];
  EntryDirectory,
  SourceDirectory : Str80;
  Day,Month,Year,
  Hour,Minute  : Integer;
  Size         : Real;
  AP           : Char;
  Entry        : EA;
  FTemp        : FRec;
  EntryNum     : Integer;
  FKey         : String[14];
  PrintCount   : Integer;
  FirstCharDelete : Boolean;
  DiskMatch : Boolean;

PROCEDURE BigWindow(a,b,c,d:Integer);
  Begin
    Window(a,b,c,d);
    { delete next line if NOT using Turbo Extender }
    { CloneCodeSegment(TurboRunDataStart,TurboRunDataLength); }
  End; { procedure BigWindow(a,b,c,d:Integer) }

CONST  VideoEnable = $08;               { Video Signal Enable Bit }
       On  = True;
       Off = False;

TYPE   Imagetype  = Array[1..4000] of char;  { Screen Image }

VAR    Screen      : Record
                       Image: Imagetype;
                       X1,Y1:   Integer;
                     End;
       Crtmode     : Byte      ABSOLUTE $0040:$0049;
       Monobuffer  : Imagetype ABSOLUTE $B000:$0000;
       Colorbuffer : Imagetype ABSOLUTE $B800:$0000;
       CrtAdapter  : Integer   ABSOLUTE $0040:$0063;
       VideoMode   : Byte      ABSOLUTE $0040:$0065;
       CurrentSaved : Boolean;


PROCEDURE Video(Switch:Boolean); { Video On/Off to avoid Read/Write snow }
  Begin
    If (Switch=Off) then Port[CrtAdapter+4] := (VideoMode-VideoEnable)
      Else Port[CrtAdapter+4] := (VideoMode or VideoEnable);
  End;

PROCEDURE SaveScreen;
  Begin
    If NOT CurrentSaved then begin
      Video(Off);
      With Screen Do Begin
        X1:=WhereX;
        Y1:=WhereY;
        If CrtMode = 7 then Image := Monobuffer Else Image := Colorbuffer ;
      End;
      Video(On);
      CurrentSaved:=True;
    End;
  End; { procedure SaveScreen }

PROCEDURE RestoreScreen;
  Begin
    If CurrentSaved then begin
      Video(Off);
      With Screen Do Begin
        If CrtMode = 7 then Monobuffer := Image Else Colorbuffer := Image;
        GotoXY(X1,Y1);
      End;
      Video(On);
      CurrentSaved:=False;
    End;
  End; { procedure RestoreScreen; }

VAR
  INT24Err: Boolean;
  INT24ErrCode: Byte;
  OldINT24: Array [1..2] Of Integer;

Procedure INT24;
  Begin
    Inline
     ($2E/$C6/$06/ INT24Err /$01/$89/$EC/$83/$C4/$08/$89/$F8/$2E/$A2/
      INT24ErrCode /$58/$B0/$FF/$5B/$59/$5A/$5E/$5F/$5D/$1F/$07/$CF);
  End;

Procedure INT24On;
  Begin
    INT24Err:=False;
    With Regs Do
     Begin
      AX:=$3524;
      MsDos(Regs);
      If (OldINT24[1] Or OldINT24[2])=0 Then
       Begin
        OldINT24[1]:=ES;
        OldINT24[2]:=BX;
       End;
      DS:=CSeg;
      DX:=Ofs(INT24);
      AX:=$2524;
      MsDos(Regs);
     End;
  End;

Procedure INT24Off;
  Begin
    INT24Err:=False;
    If OldINT24[1]<>0 Then
      With Regs Do
       Begin
        DS:=OldINT24[1];
        DX:=OldINT24[2];
        AX:=$2524;
        MsDos(Regs);
       End;
    OldINT24[1]:=0;
    OldINT24[2]:=0;
  End;

Function INT24Result: Integer;
  VAR I:Integer;
  Begin
    I:=IOResult;
    If INT24Err Then
     Begin
      I:=I+256*INT24ErrCode;
      INT24On;
     End;
    INT24Result:=I;
  End;

FUNCTION ChangedToSource: Boolean;
  Begin
    INT24On;
    {$I-}
    ChDir(SourceDirectory);
    {$I+}
    ChangedToSource:=(INT24Result=0);
    INT24Off;
  End; { function ChangedToSource }

FUNCTION CheckDOSVersion:Str3;
  VAR S,S1:Str3;
  Begin
    Regs.AX := $3000;       { Func.Call $30 (Get DOS Version Number) }
    MsDos(Regs);
    Str(Regs.AL,S);
    Str(Regs.AH,S1);
    CheckDOSVersion:=S+'.'+S1;
    If NOT (S[1] in ['2','3']) then begin
      ClrScr;
      Write(^G);
      GotoXY(10,17);
      WriteLn('Sorry...  LITTLCAT requires DOS 2.X or greater.');
      Halt;
    End;
  End; { function CheckDOSVersion }

FUNCTION ConstStr(C:Char; N:Integer) : Str80;
  VAR S : String[80];
  Begin
    If N<0 then N:=0;
    S[0] := Chr(N);
    FillChar(S[1],N,C);
    ConstStr := S;
  End;

FUNCTION PrTest: Boolean;
  VAR I : Integer;
  Begin
    Regs.ax:=$0200;
    Regs.dx:=$0000;
    Intr($17,Regs);
    I := ((regs.ax and $FF00) shr 8);
    If (I=144) then PrTest := True
      Else PrTest := False;
  End; { function PrTest }

FUNCTION MonitorType : Integer;
  Begin
    MonitorType := Mem[$0040:$0049];
  End; { function MonitorType }

PROCEDURE HideCursor;
  Begin
    Inline($B9/$0F00/$B4/$01/$CD/$10);
  End; { procedure HideCursor }

PROCEDURE RestoreCursor;
  Begin
    If MonitorType = 7 then                  { Mono }
      Inline($B9/$0C0D/$B4/$01/$CD/$10)
    Else Inline($B9/$0607/$B4/$01/$CD/$10);  { CGA }
  End; { procedure RestoreCursor }

PROCEDURE Beep;
  Begin
    Sound(660);Delay(60);
    Sound(440);Delay(60);
    Sound(660);Delay(60);
    Sound(440);Delay(60);
    NoSound;
  End;

FUNCTION Yes: Boolean;
  VAR Ch:Char;
  Begin
    Repeat
      Read(Kbd,Ch);
      Ch:=UpCase(Ch);
      If Not (Ch in ['Y','N']) then Beep;
    Until Ch in ['Y','N'];
    Yes := (Ch='Y');
  End; { function Yes }

PROCEDURE DrawBox (Left, Right, Top, Bottom : Integer);
  VAR
   Index : Integer;
  Begin
    HideCursor;
    GotoXY(Left,Top);
    Write('┌');
    For Index := Left+1 to Right-1 DO Begin
      Write('─');
    End;
    Write('┐');
    For Index := Top+1 to Bottom-1 Do Begin
      GotoXY(Left,Index);
      Write('│');
      GotoXY(Right,Index);
      Write('│');
    End;
    GotoXY(Left,Bottom);
    Write('└');
    For Index := Left+1 to Right-1 Do Begin
      Write('─');
    End;
    Write('┘');
    RestoreCursor;
  End;

FUNCTION DOSDate:Str8;
  VAR
    month,day:     string[2];
    year:          string[4];
  Begin
    Regs.AX:=$2A00;
    MsDos(Regs);
    with Regs do begin
      Str(CX,year);
      Str(DX mod 256,day);
      Str(DX shr 8,month);
    end;
    Year:=Copy(Year,3,2);
    If Length(Day) = 1 then Day:='0'+Day;
    DOSdate := month + '/' + day + '/' + year  ;
  End;

FUNCTION Freespace:real;
  VAR  fr : real;
  Begin
    with regs do begin
      dx := 0;
      ah := $36;
      MsDos(regs);
      fr := bx;
      if ax <> $FFFF then Freespace := fr * ax * cx else Freespace := 0
    End;
  End;  { function Freespace }

PROCEDURE SetDTA3;
  Begin
    Regs.AX := $1A00;       { Func.Call $1A (Set DTA) }
    Regs.DS := Seg(DTA3);
    Regs.DX := Ofs(DTA3);
    MsDos(Regs);
  End; { procedure SetDTA3 }

PROCEDURE SetASCIIZ(FName:Name);
  VAR I:Integer;
  Begin
    FillChar(ASCIIZ,SizeOf(ASCIIZ),0);
    For I:=1 to Length(FName) do ASCIIZ[I]:=FName[I];
  End; { procedure SetASCIIZ }

PROCEDURE FindFirst3(Att:Integer);
  Begin
    SetDTA3;
    Regs.AX := $4E00;       { Func.Call $4E (Find First) }
    Regs.DS := Seg(ASCIIZ);
    Regs.DX := Ofs(ASCIIZ);
    Regs.CX := Att;
    MsDos(Regs);
    Error:=Regs.AX;
  End; { procedure FindFirst3 }

PROCEDURE FindNext3;
  Begin
    SetDTA3;
    Regs.AX := $4F00;       { Func.Call $4F (Find Next) }
    Regs.DS := Seg(ASCIIZ);
    Regs.DX := Ofs(ASCIIZ);
    MsDos(Regs);
    Error:=Regs.AX;
  End; { procedure FindNext3 }

PROCEDURE GetName3;
  VAR
    I:Integer;
    S,S1:String[15];
    Name:Array[1..13] of Char;
  Begin
    S:=#0;
    S1:='';
    For I:=31 to 43 do Name[I-30]:=DTA3[I];
    For I:=31 to 30+Pos(S,Name) do S1:=S1+DTA3[I];
    I:=Pos('.',S1);
    With Entry[EntryNum] do begin
      Status:=0;
      If I=0 then begin
        FileName:=S1;
        FileExt:='';
      End Else begin
        FileName:=Copy(S1,1,I-1);
        FileExt:=Copy(S1,I+1,3);
      End;
      S:=FileName;
      S:=S+ConstStr(' ',8-Length(S));
      FileName:=S;
      S:=FileExt;
      S:=S+ConstStr(' ',3-Length(S));
      FileExt:=S;
      FileTime:=Ord(DTA3[24]);
      FileTime:=FileTime shl 8;
      FileTime:=FileTime or Ord(DTA3[23]);
      FileDate:=Ord(DTA3[26]);
      FileDate:=FileDate shl 8;
      FileDate:=FileDate or Ord(DTA3[25]);
      For I:=1 to 4 do FileSize[I]:=Ord(DTA3[I+26]);
    End;  { with }
  End; { procedure GetName3 }

PROCEDURE BuildArray;
  Begin
    If Not ChangedToSource then Beep;
    EntryNum:=0;
    FillChar(Entry,SizeOf(Entry),0);
    SetASCIIZ('*.*');
    FindFirst3(0);
    If Error=0 then begin
      EntryNum:=EntryNum+1;
      GetName3;
    End;
    If Error=0 then begin
      Repeat
      FindNext3;
      If (Error=0) and (EntryNum<250) then begin
        EntryNum:=EntryNum+1;
        GetName3;
      End;
      Until Error<>0;
    End;
  End; { procedure BuildArray }

PROCEDURE DisplayID;
  Procedure Center(R:Integer;D:Str80);
    Begin
      GotoXY((80 -Length(D)) div 2,R);
      Write(D);
    End;
  Begin
    ClrScr;
    DrawBox(10,70,1,6);
    HideCursor;
    Center(2,'LITTLCAT.COM -- A "little" CATALOGING UTILITY  V1.0');
    Center(3,'----------');
    LowVideo;
    Center(4,'Program written by Kenn Flee of Jamestown Software');
    Center(5,'2508 Valley Forge Dr., Madison WI 53719  (C)1986');
    NormVideo;
    RestoreCursor;
  End;

FUNCTION Exist(FileName : Str80) : Boolean;
  VAR
    Fil : file;
  Begin
    Assign(Fil,FileName);
    {$I-}
    Reset(Fil);
    {$I+}
    Exist := (IOResult=0);
    Close(Fil);
  End;

PROCEDURE KillTemp;
  Begin
    If Exist('LITTLCAT.TMP') then begin
      Assign(ExFile,'LITTLCAT.TMP');
      Erase(ExFile);
    End;
  End; { procedure KillTemp }

TYPE FieldType = (Af,Nf,Rf,Df,Yf);    { Alpha, Numeric, Real, Date, Yes/No }

PROCEDURE InputStr (VAR S : AnyStr;
                        L,X,Y : Integer;
                        FType : FieldType;
                        Term : CharSet;
                    VAR TC : Char);
  CONST
    UnderScore = '_';
  VAR
    P : Integer;
    Ch,Ch2 : Char;
    LegalChar : CharSet;
    FirstChar : Boolean;
    EntryString : AnyStr;
    X1,X2,X3 : Integer;
    Error : Boolean;
  Begin
    Case FType of
      Af : LegalChar := [' '..'~'];             { Alpha }
      Nf : LegalChar := ['-','0'..'9'];         { Numeric }
      Rf : LegalChar := ['-','.','0'..'9'];     { Real }
      Df : LegalChar := ['/','0'..'9'];         { Date }
      Yf : LegalChar := ['Y','y','N','n'];      { Yes/No }
    End; { case }
    GotoXY(X,Y); Write(S,ConstStr(UnderScore,L-Length(S)));
    P := 0;
    FirstChar := True;
    EntryString := S;
    Repeat
      GotoXY(X+P,Y);
      Read(Kbd,Ch);
      If ((Ch in [#32..#126]) and FirstChar) and FirstCharDelete then begin
        P:=0;
        S:='';
        Write(S,ConstStr(UnderScore,L-Length(S)));
        GotoXY(X+P,Y);
      End;
      FirstChar := False;
      Case Ch of
        #32..#126 : If (P<L) and (Ch in LegalChar) then
                    Begin
                      If FType = Yf then begin
                        Case Ch of
                          'Y','y' : S := 'Yes';
                          'N','n' : S := 'No ';
                        End;
                        P:=0;
                        GotoXY(X+P,Y);
                        Write(S,ConstStr(UnderScore,L-Length(S)));
                        Ch := #13;
                      End Else begin
                        If Length(S)=L then Delete(S,L,1);
                        P := P+1;
                        Insert(Ch,S,P);
                        Write(Copy(S,P,L));
                      End;
                    End
                    Else Beep;
               ^H : If P>0 then
                    Begin
                      Delete(S,P,1);
                      Write(^H,Copy(S,P,L),UnderScore);
                      P := P-1;
                    End
                    Else Beep;
              #27 : If KeyPressed then Begin
                      Read(Kbd,Ch2);
                      Case Ch2 of

                      { Func. Codes: F1=59 F2=60 F3=61 ... F10=68 }

                      #59 : Ch := ^Q;
                      #62 : Begin
                              P:=0;
                              S:='';
                              GotoXY(X+P,Y);
                              Write(S,ConstStr(UnderScore,L-Length(S)));
                            End;
                      #66 : Begin
                              FirstCharDelete := NOT FirstCharDelete;
                              Ch := #13;
                            End;
                      #68 : Ch := ^Z;

                      { Keypad Codes:  71 72 73
                                       75 76 77
                                       79 80 81
                                    -82- -83-    }

                      #75 : If P>0 then P := P-1
                            Else Beep;
                      #77 : If P<Length(S) then P := P+1
                            Else Beep;
                      #79 : P := Length(S);
                      #71 : P := 0;
                      #72 : Ch := ^E;
                      #80 : Ch := ^X;
                      #83 : If P<Length(S) then
                            Begin
                              Delete(S,P+1,1);
                              Write(Copy(S,P+1,L),UnderScore);
                            End;
                      End; {case}
                    End Else Begin
                      S := EntryString;
                      P:=0;
                      GotoXY(X+P,Y);
                      Write(S,ConstStr(UnderScore,L-Length(S)));
                      Ch := #13;
                    End; {begin}
      End; {case}
      If (Ch in Term) and (FType = Df) then begin
        Error := False;
        Val(Copy(S,1,2),X3,X2);
        If X2<>0 then Error := True;
        Val(Copy(S,4,2),X1,X2);
        If X2=0 then
          Case X1 of
            4,6,9,11        : If NOT (X3 in [1..30]) then Error := True;
            1,3,5,7,8,10,12 : If NOT (X3 in [1..31]) then Error := True;
            2               : If NOT (X3 in [1..29]) then Error := True
           Else Error := True;
        End Else Error := True;
        Val(Copy(S,7,2),X1,X2);
        If X2<>0 then Error := True;
        If X2=0 then If X1<85 then Error := True;
        If Error then begin
          Beep;
          P:=0;
          S:=EntryString;
          GotoXY(X+P,Y);
          Write(S,ConstStr(UnderScore,L-Length(S)));
          Ch := #0;
          FirstChar := True;
        End;
      End;
    Until Ch in Term;
    P := Length(S);
    GotoXY(X+P,Y); Write('':L-P);
    TC := Ch;
  End;

PROCEDURE QuickSortRecord(VAR Item:EA; Count:Integer);
  PROCEDURE QuickSort(SBegin,SCount:Integer;VAR It:EA);
    VAR I,J:Integer;
        X1,X2:FRec;
    Begin
      I:=SBegin;
      J:=SCount;
      X1:=It[(SBegin+SCount) div 2];
      Repeat
        While (It[I].FileName+It[I].FileExt) < (X1.FileName+X1.FileExt) do I:=I+1;
        While (X1.FileName+X1.FileExt) < (It[J].FileName+It[J].FileExt) do J:=J-1;
        If I<=J then begin
          X2:=Entry[I];
          Entry[I]:=Entry[J];
          Entry[J]:=X2;
          I:=I+1;
          J:=J-1;
        End;
      Until I>J;
      If SBegin<J then QuickSort(SBegin,J,It);
      If SBegin<SCount then QuickSort(I,SCount,It);
    End; { procedure QuickSort }
    Begin
      QuickSort(1,Count,Item);
    End;  { procedure QuickSortRecord }

PROCEDURE Boop;
  Begin
    Sound(330);
    Delay(120);
    NoSound;
  End; { procedure Boop }

PROCEDURE OpenFiles;
  Begin
    ChDir(EntryDirectory);
    OpenFile(CFile,'LITTLCAT.DAT',SizeOf(FRec));
    OpenIndex(CIndex,'LITTLCAT.IXN',14,1);
  End; { procedure OpenFiles }

PROCEDURE CloseFiles;
  Begin
    ChDir(EntryDirectory);
    CloseFile(CFile);
    CloseIndex(CIndex);
  End; { procedure CloseFiles }

PROCEDURE Show(X,Y:Integer;S:Str80);
  Begin
    GotoXY(X,Y);
    Write(S);
  End; { procedure Show }

PROCEDURE ShowScreen;
  Begin
    ClrScr;
    NormVideo;
    Show(1,2,ConstStr(#196,80));
    LowVideo;
    Show(5,2,' FILE INFORMATION ');
    Show( 3, 4,'   File Name:');
    Show( 3, 5,'        Time:');
    Show( 3, 6,'        Date:');
    Show( 3, 7,'        Size:');
    Show( 3, 8,' Volume/Path:');
    NormVideo;
    Show(1,10,ConstStr(#196,80));
    Show(1,22,ConstStr(#196,80));
  End; { procedure ShowScreen }

PROCEDURE UpdateArray;
  VAR I,R : Integer;
      S1,S2 : String[14];
  Begin
    OpenFiles;
    For I:=1 to EntryNum do begin
      Entry[I].Status:=0;
      S1:=Entry[I].FileName+Entry[I].FileExt;
      FKey:=S1;
      ClearKey(CIndex);
      SearchKey(CIndex,R,FKey);
      If OK then Begin
        S2:=Copy(FKey,1,11);
        If S1=S2 then Entry[I].Status:=1;
      End;
    End;
    CloseFiles;
  End; { procedure UpdateArray }

PROCEDURE ShowEntry(N:Integer);
  Begin
    With Entry[N] do begin
    GotoXY(17,4);
    Write(FileName,'.',FileExt);
      Size := (FileSize[1] * 1.0) +
              (FileSize[2] * 256.0) +
              (FileSize[3] * 65536.0);
      Year := (FileDate shr 9) + 80;
      Month := (FileDate shl 7) shr 12;
      Day := (FileDate shl 11) shr 11;
      Hour := FileTime shr 11;
      If Hour >= 12 then begin
        AP := 'p';
        Hour := Hour - 12;
      End Else AP := 'a';
      If Hour = 0 then Hour := 12;
      Minute := (FileTime shl 5) shr 10;
    End;
    GotoXY(17,5);
    Write(Hour:2,':');
    If Minute < 10 then Write('0');
    Write(Minute,ap);
    GotoXY(17,6);
    Write(Month:2,'-');
    If Day < 10 then Write('0');
    Write(Day,'-',Year);
    GotoXY(17,7);
    Write(Size:0:0);
    GotoXY(17,8);
    If SourceDirectory[1] in ['A','B'] then Write(OldVolumeName)
       Else Write(SourceDirectory);
  End; { procedure ShowEntry }

PROCEDURE ShowData(RecNum:Integer);
  Begin
    FillChar(FileRec,SizeOf(FileRec),0);
    GetRec(CFile,RecNum,FileRec);
    With FileRec do begin
      GotoXY(17,4);ClrEol;
      Write(FileName,'.',FileExt);
      GotoXY(60,4);ClrEol;
      Write('Record No.: ',RecNum);
      Size := (FileSize[1] * 1.0) +
              (FileSize[2] * 256.0) +
              (FileSize[3] * 65536.0);
      Year := (FileDate shr 9) + 80;
      Month := (FileDate shl 7) shr 12;
      Day := (FileDate shl 11) shr 11;
      Hour := FileTime shr 11;
      If Hour >= 12 then begin
        AP := 'p';
        Hour := Hour - 12;
      End Else AP := 'a';
      If Hour = 0 then Hour := 12;
      Minute := (FileTime shl 5) shr 10;
      GotoXY(17,5);ClrEol;
      Write(Hour:2,':');
      If Minute < 10 then Write('0');
      Write(Minute,ap);
      GotoXY(17,6);
      Write(Month:2,'-');
      If Day < 10 then Write('0');
      Write(Day,'-',Year);
      GotoXY(17,7);ClrEol;
      Write(Size:0:0);
      GotoXY(17,8);ClrEol;
      Write(VolName);
    End;
  End; { procedure ShowData }

PROCEDURE SetEpson;
  CONST N = 26;
  VAR TempCh :Char;
      Left,I : Integer;
      S:AnyStr;
  Begin
    If Monitortype=7 then begin
      For I:=7 to 25 do begin
        GotoXY(1,I);
        ClrEol;
      End;
    End Else begin
      BigWindow(1,7,80,25);
      ClrScr;
      BigWindow(1,1,80,25);
    End;
    If not PrTest then Repeat
      Beep;
      GotoXY(20,15);
      WriteLn('Printer does not appear to be ready');
      GotoXY(20,16);
      WriteLn('Press any key when ready or ESC to return to menu');
      Repeat until KeyPressed;
      Read(Kbd,TempCh);
      If (TempCh = #27) and KeyPressed then Read(Kbd,TempCh);
      If TempCh = #27 then Exit;
      If Monitortype=7 then begin
        For I:=9 to 25 do begin
          GotoXY(1,I);
          ClrEol;
        End;
      End Else begin
        BigWindow(1,9,80,25);
        ClrScr;
        BigWindow(1,1,80,25);
      End;
    Until PrTest;
    GotoXY(N,10); WriteLn('1 -- Pica  (10 chars/inch)');
    GotoXY(N,11); WriteLn('2 -- Elite (12 chars/inch)');
    GotoXY(N,12); WriteLn('3 -- Cond  (17 chars/inch)');
    GotoXY(N,13); WriteLn('4 -- Set Left Margin');
    LowVideo;
    GotoXY(N,16); WriteLn('9 -- Return to Main Menu');
    NormVideo;
    GotoXY(N,21); Write('Enter your selection: [ ]');
    Left:=1;
    TempCh:='1';
    Write(Lst,#27,'@',#13);
    Write(Lst,#27,'l',Chr(Left),#13);
    Repeat
      GotoXY(N,23);ClrEol;
      Write('Left Margin set at ',Left,'  ');
      Case TempCh of
        '1' : Write('Pica');
        '2' : Write('Elite');
        '3' : Write('Condensed');
      End;
      GotoXY(N+23,21);
      Read(Kbd,TempCh);
      Write(TempCh);
      Case TempCh of
        '1' : Write(Lst,#27,#18,#27,'P',#13);
        '2' : Write(Lst,#27,#18,#27,'M',#13);
        '3' : Write(Lst,#27,'P',#27,#15,#13);
        '4' : Begin
                Repeat
                  GotoXY(N,23);ClrEol;
                  Write('Set left margin at how many characters: ');
                  ReadLn(S);
                  Val(S,Left,I);
                  If (Left<0) or (Left>20) then I:=1;
                  If I<>0 then Boop;
                Until I=0;
                Write(Lst,#27,'l',Chr(Left),#13);
              End;
        '9' : ;
      Else Boop;
      End;
    Until TempCh = '9';
  End; {SetEpson}

FUNCTION SelectFile: Integer;
  VAR TopLine,
      BottomLine,
      OldTop,
      Current,
      Last,I       : Integer;
      DoAll : Boolean;
  Begin
    If KeyPressed then Repeat
      Read(Kbd,Ch);
    Until NOT Keypressed;
    Current:=1;
    Last:=1;
    TopLine:=1;
    BottomLine:=20;
    If BottomLine>EntryNum then BottomLine:=EntryNum;
    DoAll:=True;
    HideCursor;
    Repeat
      If DoAll then begin
        If Monitortype = 7 then begin
          For I:= 1 to 23 do begin
            GotoXY(1,I);
            Write(ConstStr(' ',13));
          End;
          GotoXY(1,1);
        End Else ClrScr;
        For I:= TopLine to BottomLine do begin
          LowVideo;
          If Entry[I].Status=1 then TextColor(1);
          If I=Current then begin
            TextBackGround(7);
            If Entry[I].Status=1 then TextColor(1) Else TextColor(0)
          End;
          WriteLn(Entry[I].FileName,' ',Entry[I].FileExt);
        End;
        OldTop:=TopLine;
      End Else begin
        GotoXY(1,1+(Current-TopLine));
        TextBackGround(7);
        If Entry[Current].Status=1 then TextColor(1) Else TextColor(0);
        WriteLn(Entry[Current].FileName,' ',Entry[Current].FileExt);
        OldTop:=TopLine;
      End;
      LowVideo;
      GotoXY(1,21);ClrEol;
      If BottomLine<EntryNum then Write('  ',#25,' MORE ',#25);
      GotoXY(1,22);
      TextColor(1);
      Write(' Blue ');
      LowVideo;
      Write('= Dup');
      Last:=Current;
      Read(Kbd,Ch);
      If (Ch=#27) and KeyPressed then Read(Kbd,Ch);
      DoAll:=False;
      Case Ch of
        #72 : Current:=Current-1;       { up }
        #80 : Current:=Current+1;       { down }
        #71 : Current:=TopLine;         { home }
        #79 : Current:=BottomLine;      { end }
        #73 : Begin
                BottomLine:=BottomLine-20;   { pgup }
                DoAll:=True;
              End;
        #81 : Begin
                BottomLine:=BottomLine+20;   { pgdn }
                DoAll:=True;
              End;
        'S','s' : Begin
                    QuickSortRecord(Entry,EntryNum);
                    Current:=1;
                    DoAll:=True;
                  End;
        #13 : ;
      Else Boop;
      End;
      GotoXY(1,1+(Last-TopLine));
      LowVideo;
      If Entry[Last].Status=1 then TextColor(1);
      WriteLn(Entry[Last].FileName,' ',Entry[Last].FileExt);
      GotoXY(1,1);
      If (Current=BottomLine+1) and (Current<=EntryNum) then DelLine;
      If (Current=TopLine-1) and (Current>0) then begin
        InsLine;
        GotoXY(1,21);
        DelLine;
      End;
      If Current<1 then Current:=1;
      If Current>EntryNum then Current:=EntryNum;
      If Current>TopLine+19 then BottomLine:=Current;
      If Current<TopLine then TopLine:=Current;
      If TopLine<>OldTop then BottomLine:=Topline+19;
      If BottomLine<20 then BottomLine:=20;
      If BottomLine>EntryNum then BottomLine:=EntryNum;
      TopLine:=BottomLine-19;
      If TopLine<1 then TopLine:=1;
      If Current<TopLine then Current:=TopLine;
      If Current>BottomLine then Current:=BottomLine;
    Until Ch in [#13,#27,#59];
    RestoreCursor;
    If Ch=#27 then SelectFile:=0
      Else If Ch=#59 then Selectfile:=-1
      Else SelectFile:=Current;
  End; { function SelectFile }

PROCEDURE volume(drivelet:Char;AskChange:Boolean);
  TYPE
    extendfcb = ARRAY[0..43] OF Char;
  VAR
    drive : byte;
    i,filetime,filedate : Integer;
    s : AnyStr;
    haslabel : Boolean;
    labl : string[11];
    dta, xfcb, sfcb : extendfcb;

  PROCEDURE initfcb(VAR x : extendfcb; namechar : Char);
    {initialize an extended fcb}
    VAR
      i : Integer;
    BEGIN
      x[0] := Chr(255);     {flag for extended FCB}
      FOR i := 1 TO 5 DO x[i] := Chr(0);
      x[6] := Chr(8);       {specifies that we want volume label}
      x[7] := Chr(0);       {where drive number goes}
      FOR i := 8 TO 18 DO x[i] := namechar;
      FOR i := 19 TO 43 DO x[i] := Chr(0);
    END;                    {initfcb}

  BEGIN
    initfcb(sfcb, '?');     {initialize buffers}
    initfcb(xfcb, ' ');
    Drive:=Ord(DriveLet)-64;
    sfcb[7] := Chr(drive);
    xfcb[7] := Chr(drive);
    regs.ax := $1A00;
    regs.ds := Seg(dta[0]);
    regs.dx := Ofs(dta[0]);
    MsDos(regs);             {SET UP DISK TRANSFER AREA FOR FILENAMES}

    regs.dx := Ofs(sfcb[0]);
    regs.ax := $1100;
    MsDos(regs);             {search for volume entry}

    IF Lo(regs.ax) = $FF THEN BEGIN
      haslabel := False;
      OldVolumeName := '<NONE>';
      OldVolumeNameDate := '';
      GotoXY(1,11); ClrEol;
      WriteLn('Diskette in drive ',drive,' has no label... please enter.');
    END ELSE BEGIN
      haslabel := True;
      OldVolumeName:='';
      FOR i := 1 TO 11 DO OldVolumeName:=OldVolumeName+(dta[7+i]);
      I:=11;
      While (OldVolumeName[I]=' ') and (I>0) do begin
        Delete(OldVolumeName,I,1);
        I:=I-1;
      End;
      filetime:=ord(dta[31]) shl 8 + ord(dta[30]);
      filedate:=ord(dta[33]) shl 8 + ord(dta[32]);
      Month := (FileDate shl 7) shr 12;
      Str(Month,S);
      OldVolumeNameDate := S + '-';
      Day := (FileDate shl 11) shr 11;
      If Day < 10 then OldVolumeNameDate := OldVolumeNameDate + '0';
      Str(Day,S);
      OldVolumeNameDate := OldVolumeNameDate + S + '-';
      Year := (FileDate shr 9) + 80;
      Str(Year,S);
      OldVolumeNameDate := OldVolumeNameDate + S + '  ';
      Hour := FileTime shr 11;
      If Hour >= 12 then begin
        AP := 'p';
        Hour := Hour - 12;
      End Else AP := 'a';
      If Hour = 0 then Hour := 12;
      Str(Hour:2,S);
      OldVolumeNameDate := OldVolumeNameDate + S + ':';
      Minute := (FileTime shl 5) shr 10;
      If Minute < 10 then OldVolumeNameDate := OldVolumeNameDate + '0';
      Str(Minute,S);
      OldVolumeNameDate := OldVolumeNameDate + S + AP;
    END;
    IF (HasLabel=False) or (AskChange) THEN Begin  {go on to change the label}
      Repeat
        Beep;
        GotoXY(30,10);ClrEol;
        ReadLn(labl);
        if (labl='') and (OldVolumeName<>'') then labl:=OldVolumeName;
        OldVolumeName:=labl;
      Until labl<>'';
      IF Length(labl) > 0 THEN BEGIN
        FOR i := 1 TO Length(labl) DO xfcb[7+i] := labl[i]; {insert label into xfcb}
        IF haslabel THEN BEGIN
          FOR i := 1 TO 11 DO dta[23+i] := xfcb[7+i]; {modify dta}
          regs.ds := Seg(dta[0]);
          regs.dx := Ofs(dta[0]);
          regs.ax := $1700;
          MsDos(regs);
        END ELSE BEGIN
          regs.ds := Seg(xfcb[0]);
          regs.dx := Ofs(xfcb[0]);
          regs.ax := $1600;
          MsDos(regs);
        END;
        GotoXY(1,11);ClrEol;
        IF Lo(regs.ax) = $FF THEN begin
          Boop;
          Write('Error in modifying label... press any key.');
          Read(Kbd,Ch);
        End ELSE Write(labl,' successfully created.');
      END;
    End;
  END; {volume}

PROCEDURE TestIt;
  VAR I,R,N,MatchCount : Integer;
      S1,S2,S3 : String[14];
      K,K2 : String[6];
  Begin
    SaveScreen;
    PrintCount:=0;
    ClrScr;
    If not PrTest then Repeat
      Beep;
      DrawBox(10,70,16,21);
      BigWindow(11,17,69,20);
      If MonitorType = 7 then begin
        HideCursor;
        For I:=1 to 4 do begin
          GotoXY(1,I);
          Write(ConstStr(' ',59));
        End;
        RestoreCursor;
      End Else ClrScr;
      HideCursor;
      GotoXY(5,2); WriteLn('Printer does not appear to be ready');
      GotoXY(5,3); WriteLn('Press any key when ready or ESC to return to menu');
      Repeat until KeyPressed;
      Read(Kbd,Ch);
      BigWindow(1,1,80,25);
      ClrScr;
      HideCursor;
      If (Ch = #27) and KeyPressed then Read(Kbd,Ch);
      If Ch = #27 then begin
        RestoreScreen;
        Exit;
      End;
    Until PrTest;
    OpenFiles;
    MatchCount:=0;
    For I:=1 to EntryNum do begin
      S1:=Entry[I].FileName+Entry[I].FileExt;
      WriteLn('Checking ',Entry[I].FileName,'.',Entry[I].FileExt);
      FKey:=S1;
      ClearKey(CIndex);
      SearchKey(CIndex,R,FKey);
      If OK then Repeat
        S2:=Copy(FKey,1,11);
        If S1=S2 then Begin
          If PrintCount=0 then Begin
            WriteLn(Lst,'Listing of duplicate file NAMES found on ',OldVolumeName,' on ',TDate);
            WriteLn(Lst,ConstStr('-',79));
            WriteLn(Lst);
            PrintCount:=3;
          End;
          GetRec(CFile,R,FileRec);
          If FileRec.VolName<>OldVolumeName then begin
            MatchCount:=MatchCount+1;
            S3:=FileRec.FileName+'.'+FileRec.FileExt;
            Write(Lst,S3,' exists on disk ');
            Write(Lst,FileRec.VolName,' with same name');
            If (Entry[I].FileDate=FileRec.FileDate) and
               (Entry[I].FileSize[1]=FileRec.FileSize[1]) and
               (Entry[I].FileSize[2]=FileRec.FileSize[2]) and
               (Entry[I].FileSize[3]=FileRec.FileSize[3]) and
               (Entry[I].FileSize[4]=FileRec.FileSize[4]) then
               WriteLn(Lst,', size and date')
            Else WriteLn(Lst);
            PrintCount:=PrintCount+1;
            If PrintCount >=55 then begin
              Write(Lst,#12);
              PrintCount:=0;
            End;
          End;
        End;
        NextKey(CIndex,R,FKey);
        S2:=Copy(FKey,1,11);
      Until S1<>S2;
    End;
    ClrScr;
    GotoXY(30,10);
    Beep;
    WriteLn(MatchCount,' matches found.');
    If MatchCount>0 then begin
      WriteLn(Lst);
      WriteLn(Lst,MatchCount,' matches found.');
      MatchCount:=0;
    End;
    If PrintCount>0 then Write(Lst,#12);
    PrintCount:=0;
    GotoXY(8,12);
    Write('Do you also wish to check for possible Date/Size duplicates?  Y/N');
    If Yes then begin
      ClrScr;
      CloseIndex(CIndex);
      If NOT (Exist('LITTLCAT.TMP')) then begin
        Write('Please wait... building new index:');
        MakeIndex(CIndex,'LITTLCAT.TMP',6,1);
        HideCursor;
        For N := 1 to FileLen(CFile)-1 do begin
          GetRec(CFile,N,FTemp);
          If FTemp.Status=0 then begin
            GotoXY(37,WhereY);ClrEol;
            Write(N);
            K:='      ';
            For I:= 1 to 4 do K[I]:=Chr(Ord(FTemp.FileSize[I]));
            K[5]:=Chr(Hi(FTemp.FileDate));
            K[6]:=Chr(Lo(FTemp.FileDate));
            AddKey(CIndex,N,K);
          End;
        End;
        RestoreCursor;
        WriteLn;
      End Else OpenIndex(CIndex,'LITTLCAT.TMP',6,1);
      For I:=1 to EntryNum do begin
        K2:='      ';
        For R:= 1 to 4 do K2[R]:=Chr(Ord(Entry[I].FileSize[R]));
        K2[5]:=Chr(Hi(Entry[I].FileDate));
        K2[6]:=Chr(Lo(Entry[I].FileDate));
        WriteLn('Checking ',Entry[I].FileName,'.',Entry[I].FileExt);
        FKey:=K2;
        ClearKey(CIndex);
        FindKey(CIndex,R,K2);
        If OK then Begin
          If PrintCount=0 then Begin
            WriteLn(Lst,'Listing of duplicate file SIZE/DATEs found on ',OldVolumeName,' on ',TDate);
            WriteLn(Lst,ConstStr('-',79));
            WriteLn(Lst);
            PrintCount:=3;
          End;
          GetRec(CFile,R,FTemp);
          If FTemp.VolName<>OldVolumeName then begin
            MatchCount:=MatchCount+1;
            Write(Lst,Entry[I].FileName,'.',Entry[I].FileExt);
            Write(Lst,' has same date and size as ',FTemp.FileName,'.',FTemp.FileExt);
            WriteLn(Lst,' on disk ',FTemp.VolName);
            PrintCount:=PrintCount+1;
            If PrintCount >=55 then begin
              Write(Lst,#12);
              PrintCount:=0;
            End;
          End;
          Repeat
            NextKey(CIndex,R,K2);
            If (FKey=K2) and OK then begin
              If PrintCount=0 then Begin
                WriteLn(Lst,'Duplicate file SIZE/DATEs found on ',SourceDirectory,' on ',TDate);
                WriteLn(Lst,ConstStr('-',79));
                WriteLn(Lst);
                PrintCount:=3;
              End;
              GetRec(CFile,R,FTemp);
              If FTemp.VolName<>OldVolumeName then begin
                MatchCount:=MatchCount+1;
                Write(Lst,Entry[I].FileName,'.',Entry[I].FileExt);
                Write(Lst,' has same date and size as ',FTemp.FileName);
                WriteLn(Lst,' on disk ',FTemp.VolName);
                PrintCount:=PrintCount+1;
                If PrintCount >=55 then begin
                  Write(Lst,#12);
                  PrintCount:=0;
                End;
              End;
            End;
          Until (K2<>FKey) or (NOT OK);
        End;
      End;
      If MatchCount>0 then begin
        WriteLn(Lst);
        WriteLn(Lst,MatchCount,' matches found.');
        MatchCount:=0;
      End;
      If PrintCount>0 then Write(Lst,#12);
    End;
    PrintCount:=0;
    RestoreScreen;
    RestoreCursor;
    CloseFiles;
  End; { procedure TestIt }

PROCEDURE TestIt2;
  VAR I,R,N,MatchCount : Integer;
      S1,S2 : String[14];
  Begin
    SaveScreen;
    PrintCount:=0;
    ClrScr;
    If not PrTest then Repeat
      Beep;
      DrawBox(10,70,16,21);
      BigWindow(11,17,69,20);
      If MonitorType = 7 then begin
        HideCursor;
        For I:=1 to 4 do begin
          GotoXY(1,I);
          Write(ConstStr(' ',59));
        End;
        RestoreCursor;
      End Else ClrScr;
      HideCursor;
      GotoXY(5,2); WriteLn('Printer does not appear to be ready');
      GotoXY(5,3); WriteLn('Press any key when ready or ESC to return to menu');
      Repeat until KeyPressed;
      Read(Kbd,Ch);
      BigWindow(1,1,80,25);
      ClrScr;
      HideCursor;
      If (Ch = #27) and KeyPressed then Read(Kbd,Ch);
      If Ch = #27 then begin
        RestoreScreen;
        Exit;
      End;
    Until PrTest;
    OpenFiles;
    MatchCount:=0;
    FKey:='';
    ClearKey(CIndex);
    SearchKey(CIndex,R,FKey);
    N:=R;
    S1:=Copy(FKey,1,11);
    While OK do begin
      WriteLn('Checking ',S1);
      NextKey(CIndex,R,FKey);
      S2:=Copy(FKey,1,11);
      If (S1=S2) and OK then Begin
        GetRec(CFile,N,FTemp);
        GetRec(CFile,R,FileRec);
        MatchCount:=MatchCount+1;
        If PrintCount=0 then Begin
          WriteLn(Lst,'Listing of duplicate file NAMES found in LITTLCAT database on ',TDate);
          WriteLn(Lst,ConstStr('-',79));
          WriteLn(Lst);
          PrintCount:=3;
        End;
        If FileRec.VolName<>OldVolumeName then begin
          MatchCount:=MatchCount+1;
          Write(Lst,FTemp.FileName,' on ',FTemp.VolName,' same as ');
          WriteLn(Lst,FileRec.FileName,' on ',FileRec.VolName);
          PrintCount:=PrintCount+1;
          If PrintCount >=55 then begin
            Write(Lst,#12);
            PrintCount:=0;
          End;
        End;
      End;
      S1:=S2;
      N:=R;
    End;;
    ClrScr;
    GotoXY(22,10);
    Beep;
    WriteLn(MatchCount,' matches found... press any key.');
    Read(Kbd,Ch);
    If MatchCount>0 then begin
      WriteLn(Lst);
      WriteLn(Lst,MatchCount,' matches found.');
      MatchCount:=0;
    End;
    If PrintCount>0 then Write(Lst,#12);
    PrintCount:=0;
    RestoreCursor;
    RestoreScreen;
    CloseFiles;
  End; { procedure TestIt2 }

PROCEDURE InitializeFiles;
  Begin
    ChDir(EntryDirectory);
    OpenFile(CFile,'LITTLCAT.DAT',SizeOf(FRec));
    If OK then OpenIndex(CIndex,'LITTLCAT.IXN',14,1);
    If NOT OK then begin
      Beep;
      GotoXY(5,25);
      Write('Files not found.  Creating new files.');
      MakeFile(CFile,'LITTLCAT.DAT',SizeOf(FRec));
      MakeIndex(CIndex,'LITTLCAT.IXN',14,1);
    End;
    CloseFile(CFile);
    CloseIndex(CIndex);
    GotoXY(1,25);ClrEol;
    InitFiles:=True;
  End; { procedure InitializeFiles }

PROCEDURE DoEntry;
  VAR I,N,RecNum:Integer;
      SkipDup:Boolean;
  PROCEDURE AddRecord;
    Begin
      With FileRec do begin
        Status:=0;
        FileName:=Entry[N].FileName;
        FileExt:=Entry[N].FileExt;
        FileTime:=Entry[N].FileTime;
        FileDate:=Entry[N].FileDate;
        For I := 1 to 4 do FileSize[I]:=Entry[N].FileSize[I];
        VolName:=OldVolumeName;
      End;
      FKey:=Entry[N].FileName+Entry[N].FileExt;
      FKey:=FKey+ConstStr(' ',13-Length(FKey));
      AddRec(CFile,RecNum,FileRec);
      If OK then begin
        AddKey(CIndex,RecNum,FKey);
      End;
      If NOT OK then begin
        DeleteRec(CFile,RecNum);
        GotoXY(1,24);ClrEol;
        Beep;
        Write('Error writing Record');
      End;
    End; { procedure AddRecord }

  Begin
    ShowScreen;
    FillChar(FileRec,SizeOf(FileRec),0);
    GotoXY(1,23);
    Write('Use Cursor UP, DOWN, HOME, END, PGUP, and PGDN, then');
    GotoXY(1,24);
    Write('press Return to select file from list.  Press ESC to quit. -->');
    GotoXY(1,25);
    Write('Press <F1> to enter ALL files   <S> to SORT into alpha order');
    SaveScreen;
    DrawBox(65,79,1,25);
    BigWindow(66,2,78,24);
    If MonitorType = 7 then begin
      HideCursor;
      For I:=1 to 23 do begin
        GotoXY(1,I);
        Write(ConstStr(' ',13));
      End;
      RestoreCursor;
      GotoXY(1,1);
    End Else ClrScr;
    LowVideo;
    UpdateArray;
    NormVideo;
    N:=SelectFile;
    BigWindow(1,1,80,25);
    RestoreScreen;
    GotoXY(1,23);ClrEol;
    GotoXY(1,24);ClrEol;
    NormVideo;
    If N=0 then Exit;
    If N=-1 then begin
      For I:=23 to 25 do begin
        GotoXY(1,I);
        ClrEol;
      End;
      GotoXY(1,24);
      Write('Enter ALL ',EntryNum,' files into database... Continue?  Y/N');
      Beep;
      If YES then begin
        GotoXY(1,24);ClrEol;
        Write('Ignore duplicate file names?  Y/N');
        Beep;
        SkipDup:=False;
        If YES then SkipDup:=True;
        OpenFiles;
        For N:=1 to EntryNum do begin
          ShowEntry(N);
          If (Entry[N].Status=1) and SkipDup then begin
            GotoXY(1,24);ClrEol;
            Write('Ignoring duplicate filename:  ',Entry[N].FileName,'.',Entry[N].FileExt);
            Boop;
          End Else begin
            FillChar(FTemp,SizeOf(FTemp),0);
            FileRec:=FTemp;
            AddRecord;
          End;
        End;
        CloseFiles;
      End;
      Exit;
    End;
    ShowEntry(N);
    FillChar(FTemp,SizeOf(FTemp),0);
    OpenFiles;
    FileRec:=FTemp;
    For I:=23 to 25 do begin
      GotoXY(1,I);ClrEol;
    End;
    GotoXY(1,23);
    Write('ADD the above entry to the database? Y/N ');
    Beep;
    If YES then AddRecord;
    CloseFiles;
    For I:=23 to 25 do begin
      GotoXY(1,I);ClrEol;
    End;
    GotoXY(1,23);
    Write('Another entry from this disk/directory? Y/N ');
    Beep;
    If YES then DoEntry;
  End; { procedure DoEntry }


PROCEDURE Inp;
  VAR N,I : Integer;
      S:AnyStr;
      S1:String[4];
  Begin
    If MonitorType = 7 then begin
      For I:=7 to 25 do begin
        GotoXY(1,I);
        ClrEol;
      End;
    End Else begin
      BigWindow(1,7,80,25);
      ClrScr;
    End;
    BigWindow(1,8,80,24);
    Beep;
    GotoXY(1,1);
    WriteLn('Position printer at beginning of new page.  Press any key when ready.');
    Read(Kbd,Ch);
    HideCursor;
    OpenFiles;
    For N := 1 to FileLen(CFile)-1 do begin
      GetRec(CFile,N,FTemp);
      If FTemp.Status=0 then begin
        S:=FTemp.FileName+'.'+FTemp.FileExt;
        While Pos(' ',S)>0 do Delete(S,Pos(' ',S),1);
        Write(S);
        Write(' on diskette ');
        WriteLn(FTemp.VolName);
        If (DiskMatch and (FTemp.VolName=MatchName))
          or (NOT DiskMatch) then SortRelease(FTemp);
      End;
    End;
    CloseFiles;
    BigWindow(1,1,80,25);
  End; { procedure Inp }

FUNCTION Less;
  VAR First  : FRec Absolute X;
      Second : FRec Absolute Y;
  Begin
    Less:= (First.VolName<Second.VolName) or
           ((First.VolName=Second.VolName) and
            (First.FileName<Second.FileName)) or
           ((First.VolName=Second.VolName) and
            (First.FileName=Second.FileName) and
            (First.FileExt<Second.FileExt));
  End; { function Less }

PROCEDURE OutP;
  CONST Header = 'Alphabetical Listing of Disks and Related Files';
  VAR N,I,Count,Page:Integer;
      S1,S2,S3,Head:Str80;
  Begin
    If ReportChoice <> 'c' then begin
      If MonitorType = 7 then begin
        For I:=7 to 25 do begin
          GotoXY(1,I);
          ClrEol;
        End;
      End Else begin
        BigWindow(1,7,80,25);
        ClrScr;
      End;
      BigWindow(1,8,80,24);GotoXY(1,1);
      WriteLn('---- SORTING COMPLETE, NOW PRINTING --------------');
      WriteLn;
      If NOT PRTest then repeat
        Beep;
        WriteLn('PRINTER NOT READY. Please correct and press any key when ready or ESC to Quit.');
        Read(Kbd,Ch);
        If (Ch=#27) and (NOT Keypressed) then begin
          BigWindow(1,1,80,25);
          Exit;
        End;
      until PRTest;
      HideCursor;
    End;
    S3:='';
    Page:=1;
    Count:=0;
    Head:=Header;
    Head:=Head+' on '+TDate;
    While NOT SortEOS do begin
      With FTemp do begin
        If (Count>=55) or (Page=1) then begin
          If Page<>1 then Write(Lst,#12);
          WriteLn(Lst,Head,ConstStr(' ',71-Length(Head)),'Page ',Page);
          WriteLn(Lst,ConstStr('-',79));
          WriteLn(Lst);
          Page:=Page+1;
          Count:=3;
        End;
        SortReturn(FTemp);
        S2:=VolName;
        If S2<>S3 then begin
          S3:=S2;
          WriteLn(Lst,S2);
          Count:=Count+1;
        End;
        S1:=FileName+'.'+FileExt;
        While Pos(' ',S1)>0 do Delete(S1,Pos(' ',S1),1);
        WriteLn('-> ',S1);
        Write(Lst,'   ',S1,ConstStr(' ',12-Length(S1)));
        Size := (FileSize[1] * 1.0) +
                (FileSize[2] * 256.0) +
                (FileSize[3] * 65536.0);
        Year := (FileDate shr 9) + 80;
        Month := (FileDate shl 7) shr 12;
        Day := (FileDate shl 11) shr 11;
        Hour := FileTime shr 11;
        If Hour >= 12 then begin
          AP := 'p';
          Hour := Hour - 12;
        End Else AP := 'a';
        If Hour = 0 then Hour := 12;
        Minute := (FileTime shl 5) shr 10;
        Write(Lst,Size:8:0,' Bytes',Hour:4,':');
        If Minute < 10 then Write(Lst,'0');
        Write(Lst,Minute,ap,Month:4,'-');
        If Day < 10 then Write(Lst,'0');
        WriteLn(Lst,Day,'-',Year,'   ');
        Count:=Count+1;
      End;
    End;
    If Count>0 then Write(Lst,#12);
    BigWindow(1,1,80,25);
  End; { procedure OutP }

PROCEDURE BrowseEdit;
  VAR S,S1,S2,SKey,FKey:AnyStr;
      RecNum:Integer;
      Done:Boolean;
      I,J,K:Integer;

  PROCEDURE EnterSearch;
    Begin
      SaveScreen;
      DrawBox(10,70,17,21);
      BigWindow(11,18,69,20);
      If MonitorType = 7 then begin
        HideCursor;
        For I:=1 to 3 do begin
          GotoXY(1,I);
          Write(ConstStr(' ',59));
        End;
        RestoreCursor;
      End Else ClrScr;
      LowVideo;
      GotoXY(5,2);
      Write('File Name to Search For:');
      S1:='';
      RestoreCursor;
      InputStr(S1,12,30,2,Af,[#13],Ch);
      For I:= 1 to Length(S1) do S1[I]:=Upcase(S1[I]);
      I:=Pos('.',S1);
      If I>0 then
      While Pos('.',S1)<>9 do S1:=Copy(S1,1,I-1)+' '+Copy(S1,I,length(S1));
      I:=Pos('.',S1);
      If I=9 then Delete(S1,I,1);
      NormVideo;
      BigWindow(1,1,80,25);
      RestoreScreen;
      FKey:=S1;
      SKey:=S1;
      HideCursor;
    End; { procedure EnterSearch }

    PROCEDURE FileSearch;
      Begin
        SearchKey(CIndex,RecNum,FKey);
        S1:=Copy(FKey,1,11);
        Done:=False;
        If NOT OK then begin
          Boop;
          GotoXY(1,1); Write(S2,' not found');
          If NOT OK then begin
            FKey:='';
            ClearKey(CIndex);
            SearchKey(CIndex,RecNum,FKey);
          End;
        End;
        If Ok then begin
        Repeat
          ShowData(RecNum);
          GotoXY(1,23);
          Write('Browsing Records Currently Entered in FILECAT Database...');
          ClrEol;
          GotoXY(1,25);
          Write('        <N> Next  <P> Previous  <S> Search');
          ClrEol;
          GotoXY(1,24);
          Write('Press:  <Q> Quit  <D> Delete  ');
          ClrEol;
          Repeat
            Read(Kbd,Ch);
            Ch:=Upcase(Ch);
            If NOT (Ch in ['N','P','Q','D','S']) then Boop;
            Until Ch in ['N','P','Q','D','S'];
            Case Ch of
              'Q' : Done:=True;
              'N' : Begin
                      NextKey(CIndex,RecNum,FKey);
                      GotoXY(1,1); Write(ConstStr(' ',40)); GotoXY(1,1);
                      If NOT OK then Write('First Record');
                      If NOT OK then NextKey(CIndex,RecNum,FKey);
                    End;
              'P' : Begin
                      PrevKey(CIndex,RecNum,FKey);
                      GotoXY(1,1); Write(ConstStr(' ',40)); GotoXY(1,1);
                      If NOT OK then Write('Last Record ');
                      If NOT OK then PrevKey(CIndex,RecNum,FKey);
                    End;
              'D' : Begin
                      SaveScreen;
                      DrawBox(10,70,17,21);
                      BigWindow(11,18,69,20);
                      If MonitorType = 7 then begin
                        For I:=1 to 3 do begin
                          GotoXY(1,I);
                          Write(ConstStr(' ',59));
                        End;
                      End Else ClrScr;
                      LowVideo;
                      GotoXY(21,2);
                      Beep;
                      TextColor(7+Blink);
                      HideCursor;
                      Write('Are you sure? Y/N');
                      NormVideo;
                      If YES then begin
                        DeleteRec(CFile,RecNum);
                        DeleteKey(CIndex,RecNum,FKey);
                        SearchKey(CIndex,RecNum,FKey);
                      End;
                      BigWindow(1,1,80,25);
                      RestoreScreen;
                      HideCursor;
                    End;
              'S' : Begin
                      GotoXY(1,1); Write(ConstStr(' ',40));
                      S2:=FKey;
                      EnterSearch;
                      S1:=FKey;
                      ClearKey(CIndex);
                      SearchKey(CIndex,RecNum,FKey);
                      If (Copy(FKey,1,Length(S1))<>S1) or (NOT OK) then begin
                        Boop;
                        GotoXY(1,1); Write(S1,' not found');
                        If NOT OK then begin
                          FKey:=S2;
                          ClearKey(CIndex);
                          SearchKey(CIndex,RecNum,FKey);
                        End;
                      End;
                      NormVideo;
                    End;
            End;
          Until Done;
        End;
      End; { procedure FileSearch }

  Begin
    ShowScreen;
    EnterSearch;
    GotoXY(60,1);
    Write('Browse / Delete');
    S2:=FKey;
    OpenFiles;
    FileSearch;
    CloseFiles;
    RestoreCursor;
  End; { procedure BrowseEdit }

PROCEDURE Menu;
  LABEL 1;
  CONST N = 17;
  VAR S:AnyStr;
      I:Integer;
      R:Real;

  PROCEDURE GetVolumeName;
    Begin
      If NOT ChangedToSource then Begin
        Beep;
        GotoXY(30,9);ClrEol;
        Write(SourceDirectory,' Drive Not Ready');
        OldVolumeName:='<NONE>';
        OldVolumeNameDate:='';
      End Else Volume(SourceDirectory[1],False);
      ChDir(EntryDirectory);
      LowVideo;
      GotoXY(17,10); ClrEol;
      Write('Volume Name: ',OldVolumeName,'   ',OldVolumeNameDate);
    End; { procedure GetVolumeName }

  Begin
  Repeat
    NormVideo;
    If NewMenu then DisplayID Else Begin
      If MonitorType = 7 then begin
        For I:=7 to 25 do begin
          GotoXY(1,I);
          ClrEol;
        End;
      End Else begin
        BigWindow(1,7,80,25);
        ClrScr;
      End;
      BigWindow(1,1,80,25);
    End;
    For I:=1 to Length(EntryDirectory) do
      EntryDirectory[I]:=UpCase(EntryDirectory[I]);
    Repeat
      S:=EntryDirectory;
      If EntryDirectory[Length(EntryDirectory)]='\'then
        S := S + 'LITTLCAT.DAT' Else
        S := S + '\LITTLCAT.DAT';
      If NOT Exist(S) then begin
        HideCursor;
        GotoXY(5,12);
        Write('Please place the');
        GotoXY(5,13);
        Write('LITTLCAT data disk in ',EntryDirectory);
        GotoXY(5,16);
        Beep;
        Write('Press <ESC> to Quit and return to DOS');
        GotoXY(5,18);
        Write('      or any key to continue...');
        Read(Kbd,Ch);
        If (Ch=#27) and Keypressed then Read(Kbd,Ch);
        RestoreCursor;
        If Ch=#27 then begin
          ClrScr;
          Halt;
        End;
        KillTemp;
        InitializeFiles;
        If MonitorType = 7 then begin
          For I:=7 to 25 do begin
            GotoXY(1,I);
            ClrEol;
          End;
        End Else begin
          BigWindow(1,7,80,25);
          ClrScr;
        End;
        BigWindow(1,1,80,25);
      End;
    until Exist(S);
    R:=FreeSpace;

    LowVideo;
    HideCursor;
    GotoXY(9,8); Write('LITTLCAT Resides on: ',EntryDirectory);
    If R<2000.0 then NormVideo;
    GotoXY(1,25); Write(R:1:0,' Left on ',EntryDirectory);
    If R<2000.00 then begin
      Beep;
      Textcolor(7+Blink);
      Write(' <--Disk almost full!');
      Delay(2000);
      LowVideo;
    End;
    GotoXY(70,8); Write('DOS: ',DOSNum);
    GotoXY(6,9); ClrEol; Write('Source Drive/Directory: ',SourceDirectory);
    OldVolumeName := '';
    OldVolumeNameDate := '';
    NormVideo;
    GotoXY(N,12); WriteLn('1 -- CHANGE Source Drive/Directory');
    GotoXY(N,13); WriteLn('2 -- ENTER New File Data');
    GotoXY(N,14); WriteLn('3 -- BROWSE / DELETE LittlCat Records');
    GotoXY(N,15); WriteLn('4 -- TEST LITTLCAT Database / SOURCE Diskette for Dups');
    GotoXY(N,16); WriteLn('5 -- PRINT Catalog of Disks');
    GotoXY(N,17); WriteLn('6 -- LABEL Source Diskette');
    LowVideo;
    GotoXY(N,19); WriteLn('7 -- Set Epson Print Codes');
    GotoXY(N,20); WriteLn('8 -- Change Color');
    GotoXY(N,21); WriteLn('9 -- End');
    NormVideo;
    If SourceDirectory[1] in ['A','B'] then GetVolumeName;
    GotoXY(N,23); Write('Enter your selection: [ ]');
    Repeat
      ReStoreCursor;
      GotoXY(N+23,WhereY);
      Read(Kbd,MenuChoice);
      Write(MenuChoice);
      If MenuChoice in ['2'..'5'] then begin
        Repeat
          INT24On;
          {$I-}
          ChDir(EntryDirectory);
          {$I+}
          I:=INT24Result;
          INT24Off;
          If I<>0 then Begin
            Beep;
            GotoXY(30,8);ClrEol;
            Write(EntryDirectory,' Drive Not Ready');
            Read(Kbd,Ch);
          End;
        Until I=0;
        If (NOT Exist('LITTLCAT.DAT')) or
           (NOT Exist('LITTLCAT.IXN')) then Menu;
      End;
      Case MenuChoice of
        '1' : Begin                          { Change Directory }
                NewMenu:=False;
                S := '';
                GotoXY(30,9); ClrEol;
                ReadLn(S);
                S:=S[1];
                If Length(S)=1 then S:=S+':';
                If Length(S)=2 then S:=S+'\';
                INT24On;
                {$I-}
                ChDir(S);
                {$I+}
                For I:=1 to Length(S) do S[I]:=UpCase(S[I]);
                I:=INT24Result;
                INT24Off;
                If (I<>0) or (NOT (S[1] in ['A','B'])) then Begin
                  Beep;
                  GotoXY(30,9);
                  Write('Drive Not Ready or Illegal Definition');
                  Delay(1000);
                End Else SourceDirectory:=S;
                LowVideo;
                GotoXY(10,9); WriteLn('  Source Directory: ',SourceDirectory);
                NormVideo;
                ChDir(EntryDirectory);
              End;
        '2' : Begin
                NewMenu:=True;
                If SourceDirectory[1] in ['A','B'] then GetVolumeName;
                If ChangedToSource then begin
                  BuildArray;
                  If EntryNum>0 then DoEntry;
                End Else Begin
                  Beep;
                  GotoXY(30,9); ClrEol;
                  Write(SourceDirectory,' Drive Not Ready');
                  Delay(1000);
                End;
                ChDir(EntryDirectory);
              End;
        '3' : Begin
                BrowseEdit;
                NewMenu:=True;
              End;
        '4' : Begin
                NewMenu:=False;
                SaveScreen;
                NormVideo;
                DrawBox(10,70,16,20);
                LowVideo;
                BigWindow(11,17,69,19);
                If MonitorType = 7 then begin
                  HideCursor;
                  For I:=1 to 3 do begin
                    GotoXY(1,I);
                    Write(ConstStr(' ',59));
                  End;
                  RestoreCursor;
                End Else ClrScr;
                HideCursor;
                GotoXY(5,2); WriteLn('Press: <ESC> Quit  <S> Test Source  <D> Test Database');
                Beep;
                Repeat
                  Read(Kbd,Ch);
                  If (Ch=#27) and Keypressed then Read(Kbd,Ch);
                  Ch:=Upcase(Ch);
                  If NOT (Ch in ['S','D',#27]) then Boop;
                Until Ch in ['S','D',#27];
                BigWindow(1,1,80,25);
                RestoreCursor;
                RestoreScreen;
                If Ch= 'D' then begin
                  ChDir(EntryDirectory);
                  TestIt2;
                End;
                If (Ch= 'S') and (ChangedToSource) then begin
                  BuildArray;
                  QuickSortRecord(Entry,EntryNum);
                  If EntryNum>0 then TestIt else Boop;
                End Else Boop;
                ChDir(EntryDirectory);
              End;
        '5' : Begin
                DiskMatch:=False;
                Beep;
                SaveScreen;
                NormVideo;
                DrawBox(10,70,16,20);
                LowVideo;
                BigWindow(11,17,69,19);
                If MonitorType = 7 then begin
                  HideCursor;
                  For I:=1 to 3 do begin
                    GotoXY(1,I);
                    Write(ConstStr(' ',59));
                  End;
                  RestoreCursor;
                End Else ClrScr;
                HideCursor;
                GotoXY(5,2); WriteLn('List Files on ALL disks?  Y/N');
                If NOT Yes then begin
                  DiskMatch:=True;
                  GotoXY(1,2);ClrEol;
                  GotoXY(4,2);
                  LowVideo;
                  Write('Enter Disk Name: ');
                  NormVideo;
                  S:=OldVolumeName;
                  RestoreCursor;
                  InputStr(S,11,WhereX,WhereY,Af,[#13],Ch);
                  For I:=1 to Length(S) do S[I]:=Upcase(S[I]);
                  If S='' then goto 1;
                  MatchName:=S;
                End;
                BigWindow(1,1,80,25);
                I:=TurboSort(SizeOf(FTemp));
                1:
                BigWindow(1,1,80,25);
                RestoreCursor;
                RestoreScreen;
                NewMenu:=False;
              End;
        '6' : If SourceDirectory[1] in ['A','B'] then begin
                Volume(SourceDirectory[1],True);
                GetVolumeName;
                NewMenu:=False;
              End;
        '7' : Begin
                SetEpson;
                NewMenu:=False;
              End;
        '8' : Begin
                CMode:=Not Cmode;
                If CMode then TextMode(3) Else TextMode(2);
                NewMenu:=True;
                Menu;
              End;
        '9' : ;
      Else Boop;
      End;
    Until MenuChoice in ['1'..'9'];
  Until MenuChoice = '9';
  End;

Begin
  InitIndex;
  KillTemp;
  DOSNum:=CheckDosVersion;
  If MonitorType = 7 then begin
    TextMode(2);
    CMode:=False;
  End Else begin
    TextMode(3);
    CMode:=True;
  End;
  TDate := DOSDate;
  GetDir(0,EntryDirectory);
  OvrPath(EntryDirectory);
  If EntryDirectory[1]='A' then SourceDirectory:='B:\'
    Else SourceDirectory:='A:\';
  OldVolumeName:='';
  InitFiles:=False;
  NewMenu:=True;
  PrintCount:=0;
  FirstCharDelete:=True;
  CurrentSaved:=False;
  Menu;
  KillTemp;
  ReStoreCursor;
  ClrScr;
End.